home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / gnome-games / aisleriot / games / aunt_mary.scm < prev    next >
Encoding:
Text File  |  2009-04-14  |  1.6 KB  |  72 lines
  1. ;; AisleRiot - aunt_mary.scm  -*-scheme-*-
  2. ;; Copyright (C) Alan Horkan, 2005.
  3. ;; Aunt Mary is a very difficult Klondike variation.  
  4. ;; 
  5. ;; Goodsol gives odds as < 1%.  It is possible to win in theory.  
  6. ;; In practice I've only ever won when the deck wasn't shuffled
  7.  
  8. (load "klondike.scm") 
  9.  
  10. (define deal-one #t)
  11. (define deal-three #f)
  12. (define no-redeal #f)
  13.  
  14. (define max-redeal 2)
  15.  
  16. (define tableau '(6 7 8 9 10 11))
  17.  
  18. (define (new-game)
  19.   (initialize-playing-area)
  20.   (set-ace-low)
  21.  
  22.   (make-standard-deck)
  23.   (shuffle-deck)
  24.  
  25.   ;; Stock 
  26.   (add-normal-slot DECK)
  27.   (if deal-three
  28.       (add-partially-extended-slot '() right 3)
  29.       (add-normal-slot '()))
  30.  
  31.   ;; Foundation (4)
  32.   (add-normal-slot '())
  33.   (add-normal-slot '())
  34.   (add-normal-slot '())
  35.   (add-normal-slot '())
  36.   (add-carriage-return-slot)
  37.   ;; Tableau (6)
  38.   (add-extended-slot '() down)
  39.   (add-extended-slot '() down)
  40.   (add-extended-slot '() down)
  41.   (add-extended-slot '() down)
  42.   (add-extended-slot '() down)
  43.   (add-extended-slot '() down)
  44.  
  45.   ;; Pretty Good Solitaire (goodsol) deals Aunt Mary like this
  46.   (deal-cards stock 
  47.     '(  7 8 9 10 11 
  48.           8 9 10 11  
  49.             9 10 11 
  50.               10 11 
  51.                  11))
  52.   (deal-cards-face-up stock 
  53.     '(6 
  54.       6 7 
  55.       6 7 8 
  56.       6 7 8 9 
  57.       6 7 8 9 10 
  58.       6 7 8 9 10 11))
  59.  
  60.   (give-status-message)
  61.  
  62.   (list 6 3)
  63. )
  64.  
  65. (define (get-options) 
  66.   #f)
  67.  
  68. (define (apply-options options) 
  69.   #f)
  70.  
  71. (set-lambda new-game button-pressed button-released button-clicked button-double-clicked game-over game-won get-hint get-options apply-options timeout droppable? dealable?)
  72.